home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / harvest.cpt / Harvest C / Tcl 6.2 / tclTest.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-03-01  |  3.9 KB  |  211 lines
  1. /* 
  2.  * tclTest.c --
  3.  *
  4.  *    Test driver for TCL.
  5.  *
  6.  * Copyright 1987-1991 Regents of the University of California
  7.  * All rights reserved.
  8.  *
  9.  * Permission to use, copy, modify, and distribute this
  10.  * software and its documentation for any purpose and without
  11.  * fee is hereby granted, provided that the above copyright
  12.  * notice appears in all copies.  The University of California
  13.  * makes no representations about the suitability of this
  14.  * software for any purpose.  It is provided "as is" without
  15.  * express or implied warranty.
  16.  */
  17.  
  18. #ifndef lint
  19. static char rcsid[] = "$Header: /user6/ouster/tcl/tclTest/RCS/tclTest.c,v 1.19 91/11/17 14:07:21 ouster Exp $ SPRITE (Berkeley)";
  20. #endif
  21.  
  22. #include <stdio.h>
  23. #include <errno.h>
  24. #include <string.h>
  25. #include "tcl.h"
  26.  
  27. extern int exit();
  28. extern int Tcl_DumpActiveMemory();
  29.  
  30. Tcl_Interp *interp;
  31. Tcl_CmdBuf buffer;
  32. char dumpFile[100];
  33. int quitFlag = 0;
  34.  
  35. char *initCmd =
  36.     "if [file exists [info library]/init.tcl] {source [info library]/init.tcl}";
  37.  
  38.     /* ARGSUSED */
  39. int
  40. cmdCheckmem(clientData, interp, argc, argv)
  41.     ClientData clientData;
  42.     Tcl_Interp *interp;
  43.     int argc;
  44.     char *argv[];
  45. {
  46.     if (argc != 2) {
  47.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  48.         " fileName\"", (char *) NULL);
  49.     return TCL_ERROR;
  50.     }
  51.     strcpy(dumpFile, argv[1]);
  52.     quitFlag = 1;
  53.     return TCL_OK;
  54. }
  55.  
  56.     /* ARGSUSED */
  57. int
  58. cmdEcho(clientData, interp, argc, argv)
  59.     ClientData clientData;
  60.     Tcl_Interp *interp;
  61.     int argc;
  62.     char *argv[];
  63. {
  64.     int i;
  65.  
  66.     for (i = 1; ; i++) {
  67.     if (argv[i] == NULL) {
  68.         if (i != argc) {
  69.         echoError:
  70.         sprintf(interp->result,
  71.             "argument list wasn't properly NULL-terminated in \"%s\" command",
  72.             argv[0]);
  73.         }
  74.         break;
  75.     }
  76.     if (i >= argc) {
  77.         goto echoError;
  78.     }
  79.     fputs(argv[i], stdout);
  80.     if (i < (argc-1)) {
  81.         printf(" ");
  82.     }
  83.     }
  84.     printf("\n");
  85.     return TCL_OK;
  86. }
  87.  
  88. #ifdef macintosh
  89.  
  90. char    **environ = NULL;
  91.  
  92. #endif
  93.  
  94.  
  95. #ifdef macintosh
  96.  
  97. Feedback(format, arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7)
  98. char    *format, *arg0, *arg1, *arg2, *arg3, *arg4, *arg5, *arg6, *arg7;
  99.     {
  100.     fprintf(stderr, format, arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7);
  101.     }
  102.  
  103. RotateCursor(phase)
  104. long    phase;
  105.     {
  106.     }
  107.  
  108. #endif
  109.  
  110. int
  111. main(argc, argv, envp)
  112. int        argc;
  113. char    *argv[];
  114. char    *envp[];
  115. {
  116.     char line[1000], *cmd;
  117.     int result, gotPartial;
  118.  
  119.  
  120. #ifdef macintosh
  121.     {
  122.     int        i;
  123.     char    *ptr;
  124.     
  125.     for (i=0; envp[i] != NULL ; i++)
  126.         {
  127.         for (ptr = envp[i] ; *ptr++ ; )
  128.             ;
  129.         *ptr = '=';
  130.         }
  131.     
  132.     environ = envp;
  133.     }
  134. #endif
  135.  
  136.  
  137.     interp = Tcl_CreateInterp();
  138. #ifdef TCL_MEM_DEBUG
  139.     Tcl_InitMemory(interp);
  140. #endif
  141.     Tcl_CreateCommand(interp, "echo", cmdEcho, (ClientData) "echo",
  142.         (Tcl_CmdDeleteProc *) NULL);
  143.     Tcl_CreateCommand(interp, "checkmem", cmdCheckmem, (ClientData) 0,
  144.         (Tcl_CmdDeleteProc *) NULL);
  145.     buffer = Tcl_CreateCmdBuf();
  146.     result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
  147.     if (result != TCL_OK) {
  148.     printf("%s\n", interp->result);
  149.     exit(1);
  150.     }
  151.  
  152.     gotPartial = 0;
  153.     while (1) {
  154.     clearerr(stdin);
  155.     if (!gotPartial) {
  156.         fputs("% ", stdout);
  157.         fflush(stdout);
  158.     }
  159.     if (fgets(line, 1000, stdin) == NULL) {
  160.         if (!gotPartial) {
  161.         exit(0);
  162.         }
  163.         line[0] = 0;
  164.     }
  165.     cmd = Tcl_AssembleCmd(buffer,
  166.                 ( line[0] == '%' ? ( line[1] == ' ' ? &line[2] : &line[1] ) : line ) );
  167.     if (cmd == NULL) {
  168.         gotPartial = 1;
  169.         continue;
  170.     }
  171.  
  172.     gotPartial = 0;
  173.     result = Tcl_RecordAndEval(interp, cmd, 0);
  174.     if (result == TCL_OK) {
  175.         if (*interp->result != 0) {
  176.         printf("%s\n", interp->result);
  177.         }
  178.         if (quitFlag) {
  179.         Tcl_DeleteInterp(interp);
  180.         Tcl_DeleteCmdBuf(buffer);
  181. #ifdef TCL_MEM_DEBUG
  182.         Tcl_DumpActiveMemory(dumpFile);
  183. #endif
  184.         exit(0);
  185.         }
  186.     } else {
  187.         if (result == TCL_ERROR) {
  188.         printf("Error");
  189.         } else {
  190.         printf("Error %d", result);
  191.         }
  192.         if (*interp->result != 0) {
  193.         printf(": %s\n", interp->result);
  194.         } else {
  195.         printf("\n");
  196.         }
  197.     }
  198.     }
  199. }
  200.  
  201. #ifdef macintosh
  202.  
  203. check_environment_set_of_globals(name, value)
  204. char    *name;
  205. char    *value;
  206.     {
  207.     }
  208.  
  209. #endif
  210.  
  211.